home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
viewmrg.zip
/
RBBSSUB1.MRG
< prev
next >
Wrap
Text File
|
1988-10-25
|
18KB
|
541 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RBBSSUB1.BAS to produce D:\LITE\RBBSSUB1.OLD
* RBBSSUB1.BAS: Date 10-2-1988 Size 52864 bytes
* ------------[ Created 10-25-1988 20:16:19 ]------------
* REPLACING old line(s) by new
118 INPUT #2, TURN.PRINTER.OFF,_ ' Turn printer off each recycle
DIRECTORY.PATH$, _ ' Where dir files are stored
MIN.SEC.TO.VIEW, _
LIMIT.SEARCH.TO.FMS, _
DEFAULT.CATEGORY.CODE$, _
DIR.CATEGORY.FILE$, _
NEW.FILES.CHECK, _
MAX.DESC.LEN, _
SHOW.SECTION, _
COMMANDS.IN.PROMPT, _
NEWUSER.SETS.DEFAULTS, _
HELP.PATH$, _
HELP.EXTENSION$, _
MAIN.COMMANDS$, _
FILE.COMMANDS$, _
UTIL.COMMANDS$, _
GLOBAL.COMMANDS$, _
SYSOP.COMMANDS$
INPUT #2, RECYCLE.WAIT, _
OPT.SEC(39), _ ' SECURITY FOR LIBRARY COMMANDS 1
OPT.SEC(40), _
OPT.SEC(41), _
OPT.SEC(42), _
OPT.SEC(43), _
OPT.SEC(44), _
OPT.SEC(45), _ ' LIBRARY COMMANDS 7
LIBRARY.DRIVE$, _
LIBRARY.DIRECTORY.PATH$, _
LIBRARY.DIRECTORY.EXTENTION$, _
LIBRARY.WORK.DISK.PATH$, _
LIBRARY.MAX.DISK, _
LIBRARY.MAX.DIRECTORY, _
LIBRARY.MAX.SUBDIR, _
LIBRARY.SUBDIR.PREFIX$, _
LIBRARY.ARCHIVE.PATH$, _
LIBRARY.ARCHIVE.PROGRAM$, _
LIBRARY.COMMANDS$
'
' ***** ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS ****
' ***** GET DOS SUB-DIRECTORY RBBS-PC OPTIONS ****
'
INPUT #2, UPLOAD.PATH$, _ ' Where upl dir goes
MAIN.FMS.DIRECTORY$, _ ' Shared dir in FMS
ANS.MENU$, _
REQUIRED.QUESTIONNAIRE$,_
REMEMBER.NEW.USERS,_
SURVIVE.NOUSER.ROOM,_
PROMPT.HASH$,_
START.HASH,_
LEN.HASH,_
PROMPT.INDIV$,_
START.INDIV,_
LEN.INDIV
INPUT #2, BYPASS.MSGS, _
MUSIC, _
RESTRICT.BY.DATE, _
DAYS.TO.WARN, _
DAYS.IN.REGISTRATION.PERIOD, _
CALLBACK.VERIFICATION, _
RESTRICT.VALID.CMDS, _
NEW.USER.DEFAULT.MODE, _
NEW.USER.LINE.FEEDS, _
* ------[ first line different ]------
ARKVIEW.PATH$, _ 'VIEWARC info comes from CONFIG.EXE
NEW.USER.BELL, _
NEW.USER.CASE, _
NEW.USER.MARGINS, _
WRAP.CALLERS.FILE$, _
REDIRECT.IO.METHOD, _
GO.TO.SHELL, _
HALT.ON.ERROR, _
NEW.PUBLIC.MSGS.SECURITY, _
NEW.PRIVATE.MSGS.SECURITY, _
SECURITY.NEEDED.TO.CHANGE.MSGS, _
SL.CATEGORIZE.UPLOADS, _
BAUDOT, _
TIME.TO.DROP.TO.DOS, _
EXPIRED.SECURITY, _
DTR.DROP.DELAY, _
ASK.IDENTITY, _
USE.EXTERNAL.XMODEM, _
BUFFER.SIZE, _
MLCOM, _
SHOOT.YOURSELF, _
F7.MESSAGE$, _
NEW.USER.DEFAULT.PROTOCOL$, _
NEW.USER.GRAPHICS$, _
NET.MAIL$, _
MASTER.DIRECTORY.NAME$, _
PROTO.DEF$, _
UPCAT.HELP$, _
ALWAYS.STREW.TO$, _
LAST.NAME.PROMPT$
INPUT #2, PERSONAL.DRVPATH$, _
PERSONAL.DIR$, _
PERSONAL.BEGIN, _
PERSONAL.LEN, _
PERSONAL.PROTOCOL$, _
PERSONAL.CONCAT , _
PRIVATE.READ.SEC, _
PUBLIC.READ.SEC, _
SEC.CHANGE.MSG, _
KEEP.INIT.BAUD, _
MAIN.PUI$, _
DEFAULT.ECHOER$, _
HOST.ECHO.ON$, _
HOST.ECHO.OFF$, _
SWITCH.BACK, _
DEFAULT.LINE.ACK$, _
ALTDIR.EXTENSION$, _
DIRECTORY.PREFIX$
IF CONFERENCE.MODE THEN _
INPUT #2, DF, _
DF, _
DF _
ELSE INPUT #2, DF,_
MODEM.INIT.WAIT.TIME, _
MODEM.COMMAND.DELAY.TIME
INPUT #2, TURBO.RBBS, _
SUBDIR.COUNT, _
DF, _
UPLOAD.TO.SUBDIR, _
DF, _
UPLOAD.SUBDIR$, _
MIN.OLDCALLER.BAUD, _
USE.EXTERNAL.YMODEM, _
DISKFULL.GO.OFFLINE, _
EXTENDED.LOGGING
IF CONFERENCE.MODE THEN _
INPUT #2, DF$, _
DF$, _
DF$, _
DF$ _
ELSE INPUT #2, MODEM.RESET.COMMAND$, _
MODEM.COUNT.RINGS.COMMAND$, _
MODEM.ANSWER.COMMAND$, _
MODEM.GO.OFFHOOK.COMMAND$
INPUT #2,DISK.FOR.DOS$, _
DUMB.MODEM, _
COMMENTS.AS.MESSAGES
IF CONFERENCE.MODE THEN _
INPUT #2, DF, _
DF, _
DF, _
DF, _
DF, _
DF _
ELSE INPUT #2, LSB,_
MSB,_
LINE.CONTROL.REGISTER,_
MODEM.CONTROL.REGISTER,_
LINE.STATUS.REGISTER,_
MODEM.STATUS.REGISTER
INPUT #2,KEEP.TIME.CREDITS, _
XON.XOFF, _
ALLOW.CALLER.TURBO, _
USE.DEVICE.DRIVER$, _
PRELOG$, _
NEW.USER.QUESTIONNAIRE$, _
EPILOG$, _
REGISTRATION.PROGRAM$, _
QUES.PATH$, _
USER.LOCATION$, _
DF$, _
DF$, _
DF$, _
ENFORCE.UPLOAD.DOWNLOAD.RATIOS, _
SIZE.OF.STACK, _
SECURITY.EXEMPT.FROM.EPILOG, _
USE.BASIC.WRITES, _
DOSANSI, _
ESCAPE.INSECURE, _
USE.DIR.ORDER, _
ADD.DIR.SECURITY, _
MAX.EXTENDED.LINES, _
ORIG.COMMANDS$
INPUT #2,LOGON.MAIL.LEVEL$, _
MACRO.DRVPATH$, _
MACRO.EXTENSION$, _
EMPHASIZE.ON.DEF$, _
EMPHASIZE.OFF.DEF$, _
FG.1.DEF$, _
FG.2.DEF$, _
FG.3.DEF$, _
FG.4.DEF$, _
SECVIO.HLP$, _
FOSSIL, _
MAX.CARRIER.WAIT, _
DF, _
SMART.TEXT, _
TIME.LOCK, _
WRITE.BUF.DEF, _
DF, _
DF, _
DF, _
AUTOPAGE.DEF$
IF EC > 0 THEN _
EXIT SUB
CALL EDITDEF
END SUB
' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
' $PAGE
'
' SUBROUTINE NAME -- OPENCOM
'
' INPUT PARAMETERS -- PARAMETER MEANING
' BAUD.RATE$ BAUD TO OPEN MODEM
' PARITY$ PARITY TO OPEN MODEM
'
' OUTPUT PARAMETERS -- BAUD.TEST BAUD RATE TO SET RS232 AT
'
' SUBROUTINE PURPOSE -- TO OPEN THE COMMUNICATIONS PORT.
'
SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
ON ERROR GOTO 65000
* REPLACING old line(s) by new
59660 SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
ON ERROR GOTO 65000
FIELD #2,REC.LEN AS UPLOAD.RECORD$
LSET UPLOAD.RECORD$ = STRNG$
REC.NUM = REC.NUM + 1
PUT #2,REC.NUM
END SUB
* ------[ first line different ]------
'
'
' $SUBTITLE: 'VIEWTXT - Subroutine to display ASCII file from ARC file'
' $PAGE
'
SUB VIEWTXT STATIC
ON ERROR GOTO 65000
* INSERTING new line(s)
60148 SUBROUTINE.PARAMETER = 1
CALL SKIPLINE (1)
A$ = "Would you like to view an ASCII file from this ARC (Y/[N])" 'DMOD1
CALL TGET
IF NOT YES THEN _
EXIT SUB
60149 A$ = "What file(s) to view, [ENTER] quits" 'DMOD1
CALL TGET
B = 1 'DMOD1
IF Q = 0 THEN _ 'DMOD1
EXIT SUB 'DMOD1
LAST.ARC = Q 'DMOD1
FIRST.ARC = B 'DMOD1
FOR ARC.INDEX = FIRST.ARC TO LAST.ARC 'DMOD1
Z$ = B$(ARC.INDEX) 'DMOD1
CALL ALLCAPS (Z$)
CALL PETER2 'PEMOD1
IF OK = FALSE THEN 60149 'PEMOD1
CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE) 'DMOD1
IF EXT$ = "ARC" OR EXT$ = "COM" OR EXT$ = "EXE" OR EXT$ = "BAS" OR _ 'DMOD1
EXT$ = "BIN" OR EXT$ = "LIB" OR EXT$ = "OBJ" THEN _ 'DMOD1
CALL QTPUT ("Sorry, only ASCII files can be viewed",1) :_ 'DMOD1
GOTO 60149 'DMOD1
CALL QTPUT ("Please stand by while I extract that file....",1) 'DMOD1
SHOWME$ = "PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$'PEMOD1
SHELL SHOWME$ 'PEMOD1
Z$ = ARKVIEW.PATH$ +"\"+ Z$ 'Added \ to fix error 63
TEMP$ = Z$ 'PEMOD1
CALL BUFFILE (Z$,X) '10/09/88.fix
CALL KILLWORK(TEMP$) 'get rid of the files that were xtracted 10/09/88
NEXT 'DMOD1
60152 END SUB
'
'*******************************
'* Subroutine for Viewarc txt *
'*******************************
' SUBTITLE: 'PETER2
' $PAGE
SUB PETER2 STATIC
OK = TRUE
IF INSTR(Z$,"*") OR INSTR(Z$,"?") THEN _
OK = FALSE : _
CALL QTPUT ("Sorry Widcars NOT allowed !!",1)
END SUB
'******************** INSERTED DLVIEWARC HERE ******************
'
' $SUBTITLE: 'DLVIEWARC - Subroutine to DL a file from ARC file'
' $PAGE
'
SUB DLVIEWARC STATIC
ON ERROR GOTO 65000
60168 DLARC = 0
SUBROUTINE.PARAMETER = 1
CALL SKIPLINE (1)
A$ = "Would you like to DOWNLOAD a file from this ARC (Y/[N])" 'DMOD1
CALL TGET
IF NOT YES THEN _
EXIT SUB
60169 DLARC=1
CALL QTPUT(FILE.NAME.HOLD$ + " Contains the following Files",1)
CALL VIEWARC
SUBROUTINE.PARAMETER = 1
CALL SKIPLINE (1)
A$ = "What file(s) to download, [ENTER] quits" 'DMOD1
CALL TGET
B = 1 'DMOD1
IF Q = 0 THEN _ 'DMOD1
EXIT SUB 'DMOD1
LAST.ARC = Q 'DMOD1
FIRST.ARC = B 'DMOD1
FOR ARC.INDEX = FIRST.ARC TO LAST.ARC 'DMOD1
Z$ = B$(ARC.INDEX) 'DMOD1
CALL ALLCAPS (Z$)
CALL PETER2 'PEMOD1
IF OK = FALSE THEN 60169 'PEMOD1
CALL BRKFNAME (Z$,DRV$,PREFIX$,EXT$,FALSE) 'DMOD1
CALL QTPUT ("Please stand by while I extract that file....",1) 'DMOD1
SHOWME$ = "PKXARC -R " + FILE.NAME$ + " " + Z$ + " "+ARKVIEW.PATH$'PEMOD1
SHELL SHOWME$
IF DLARC = 1 THEN _
CALL QTPUT(Z$+" Is now Extracted ...",2)
NEXT
CALL QTPUT ("One Moment while I ARC the file for you........",1)
'
'********** ARC all files in the ARKVIEW.PATH$ into VIEWARC.ARC **********
'
SHELL "PKARC A " + ARKVIEW.PATH$ + "\VIEW.ARC " + ARKVIEW.PATH$ + "\*.*"
'
'********** Deletes the files that were just ARCED into VIEWARC.ARC **********
'
FOR ARC.INDEX = FIRST.ARC TO LAST.ARC
Z$ = B$(ARC.INDEX)
CALL KILLWORK (ARKVIEW.PATH$ + "\" + Z$)
NEXT ARC.INDEX
'
'********** Tells the caller the name of the file to download **********
'
CALL QTPUT (CHR$(7)+"File has been ARCHIVED ...and named... VIEW.ARC....",2)
CALL QTPUT (CHR$(7)+"To Download this file You MUST enter VIEW.ARC as the file name",2)
CALL DELAYIT (5)
60172 END SUB
'
' $SUBTITLE: 'Error Handling for separately compiled subroutines'
' $PAGE
'
' *****************************************************************************
' * Error handling for the separately compiled subroutines of RBBS-PC *
' *****************************************************************************
'
* REPLACING old line(s) by new
65000 IF DEBUG THEN _
A$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
STR$(ERL) + _
" ERR=" + _
STR$(ERR) : _
IF PRINTER THEN _
CALL PRINTIT(A$) _
ELSE CALL LPRNT(A$,1)
EC = ERR
'
' SETCALL
'
IF ERL = 110 THEN _
RESUME NEXT
'
' OPEN CONFIG FILE
'
IF ERL => 117 AND ERL <= 118 THEN _
RESUME NEXT
'
' OPEN COM PORT ERROR HANDLING
'
IF ERL = 200 THEN _
CLS : _
CALL LPRNT("Fatal error opening " + COM.PORT$,1) : _
CALL LPRNT ("DOS ERROR=" + STR$(ERR),1) : _
STOP
'
' GETCOM ERROR HANDLING
'
IF ERL = 1420 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 1420 AND ERR = 69 THEN _
SUBROUTINE.PARAMETER = -1 :_
RESUME NEXT
'
' OPENRESEQ ERROR HANDLING
'
IF ERL = 1481 THEN _
EC = ERR : _
RESUME NEXT
'
' OPENUSER ERROR HANDLING
'
IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
CALL DELAYIT (30) : _
RESUME
'
' FINDUSER ERROR HANDLING
'
IF ERL = 12610 THEN _
RESUME NEXT
'
' UPDTCALR ERROR HANDLING
'
IF ERL = 13663 THEN _
RESUME NEXT
IF ERL = 13670 AND ERR = 61 THEN _
CALL QTPUT ("Disk Full",1) : _
IF DISKFULL.GO.OFFLINE THEN _
GOTO 65010 _
ELSE RESUME NEXT
'
' PRINTER ERROR HANDLING
'
IF ERL = 13674 THEN _
PRINTER = FALSE : _
RESUME
'
' CHANGEDIR ERROR HANDLING
'
IF ERL = 20103 THEN _
OK = FALSE : _
RESUME NEXT
'
' FINDIT ERROR HANDLING
'
IF ERL = 20221 THEN _
RESUME NEXT
IF ERL = 20223 AND EC = 58 THEN _
EC = 64 : _
OK = FALSE : _
RESUME NEXT
IF ERL = 20223 AND EC = 76 THEN _
CALL LPRNT("Bad path. File name is " + FILNAME$,1) : _
EC = 76 : _
OK = FALSE : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 AND EC = 70 _
AND NETWORK.TYPE = 6 THEN _
EC = 0 : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 THEN _
RESUME
'
' FLUSHCOM ERROR HANDLING
'
IF ERL = 20311 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 20311 AND ERR = 69 THEN _
ABORT = TRUE : _
SUBROUTINE.PARAMETER = -1 : _
RESUME NEXT
'
' NETBIOS ERROR HANDLING
'
IF ERL => 29900 AND ERL <= 29920 THEN _
RESUME NEXT
'
' UPDATEC ERROR HANDLING
'
IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
A$ = "* Disk full - terminating *" : _
SUBROUTINE.PARAMETER =2 : _
CALL TPUT : _
IF DISKFULL.GO.OFFLINE THEN _
GOTO 65010 _
ELSE SYSTEM
'
' FINDFREE ERROR HANDLING
'
'
' OPENWORK ERROR HANDLING
'
'
' OPENFMS ERROR HANDLING
'
'
' OPENOUTW ERROR HANDLING
'
'
' KILLWORK ERROR HANDLING
'
'
' GETPASWD ERROR HANDLING
'
'
' READDIR ERROR HANDLING
'
'
' READSEC ERROR HANDLING
'
'
' READANY ERROR HANDLING
'
'
' PRINTWRK ERROR HANDLING
'
'
' GETWORK ERROR HANDLING
'
'
' OPENWRKA ERROR HANDLING
'
'
' PRNTWRKA ERROR HANDLING
'
'
' CHECKINT ERROR HANDLING
'
IF ERL = 59652 AND ERR = 24 THEN _
NOT.CTS = TRUE : _
CALL LINE25 : _
RESUME
IF ERL => 52000 AND ERL <= 59660 THEN _
RESUME NEXT
* ------[ first line different ]------
' VIEWARC ERROR HANDLER
'
IF ERL = 60149 AND ERR = 53 THEN _
CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
RESUME NEXT
IF ERL = 60149 AND ERR = 63 THEN _
CALL QTPUT ("ERROR Occured, Please notify SysOp",1):_
RESUME NEXT
'
'
' DLVIEW ARC TXT ERROR HANDLER
'
IF ERL = 60169 AND ERR = 53 THEN _
CALL QTPUT ("ERROR !!! No Such File, EXITING",1):_
RESUME NEXT
'
' CATCH ALL OTHER ERRORS
'
A$ = "RBBS-SUB1 Untrapped Error" + _
STR$(ERR) + _
" in line" + _
STR$(ERL)
CALL QTPUT (A$,1)
CALL UPDTCALR (A$,2)
RESUME NEXT
' SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL